home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d13 / oki192_3.arc / OKI.PAS < prev   
Pascal/Delphi Source File  |  1991-03-27  |  35KB  |  804 lines
  1. {
  2.  
  3. PRINTER SETUP FOR THE IBM CONFIGURED OKIDATA 192 - 193
  4.  
  5. Select fonts, print quality, line spacing, form length, margins, alternate
  6. character sets, special functions, default setup, printer test
  7. by Norman Newbury, January 1987            ***  FOR PUBLIC DOMAIN USE  ***
  8.  
  9.  
  10. Note: if you compile this on a machine with a monochrome adapter it will run
  11. on either color or monochrome machines ─ if you compile on a machine  with a
  12. color graphics adapter it only runs on color machines.  This is because of the
  13. way Turbo's Window procedure works ( so far as I can determine ).
  14.  
  15. }
  16.  
  17. program printer;
  18.   type
  19.      AnyString   = String[80];          { type for Center procedure          }
  20.   const
  21.      Beep        : Char    = ^G;        { beep the console on error          }
  22.      Working     : Boolean = true;      { loop control for main program      }
  23.      Done        : Boolean = false;     { loop control for procedures        }
  24.      IBM2        : Boolean = false;     { flag for IBM character set 2       }
  25.      IOerr       : Boolean = false;     { for I/O error handling             }
  26.      SetStr      : String[20] = 'ASCII unslashed 0';    { character set name }
  27.  
  28.      Text        : Integer = 11;        { Screen colors can be changed here  }
  29.      Back        : Integer = 0;         { by changing integer values.        }
  30.      Border      : Integer = 14;        { 0 to 15 for regular non─blinking   }
  31.      Bold        : Integer = 15;        {                                    }
  32.   var
  33.      I           : Integer;             { loop counter                       }
  34.      Ch          : Char;                { characters read from keyboard      }
  35.  
  36.  
  37. {****************************************************************************}
  38. {*                                                                          *}
  39. {*                                  SCREENS                                 *}
  40. {*                                                                          *}
  41. {****************************************************************************}
  42.  
  43.  
  44. Procedure ClearBox(X1,Y1,X2,Y2 : Integer);
  45.    begin
  46.       Window(X1,Y1,X2,Y2);
  47.       ClrScr;
  48.       Window(1,1,80,25);
  49.    end; { of procedure ClearBox }
  50.  
  51. Function Monochrome : Boolean;
  52.    type RegPack = Record AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS : Integer end;
  53.    var  Regs    : RegPack;
  54.    begin
  55.       Intr(17,Regs);
  56.       if (Regs.AX and $0030) = $30 then Monochrome := true
  57.       else Monochrome := false
  58.    end; { of function monochrome }
  59.  
  60. Procedure CursorOn;                          { HIGHLY specific to the IBM PC }
  61.    type RegPack = Record AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS : Integer end;
  62.    var  Regs    : RegPack;
  63.    begin
  64.       With Regs Do Begin
  65.          AX := $0100;
  66.          if Monochrome then CX := $0B0C else CX := $0607;
  67.       end;
  68.       Intr(16,Regs)
  69.    end; { of CursorOn }
  70.  
  71.  
  72. Procedure CursorOff;                         { HIGHLY specific to the IBM PC }
  73.    type RegPack = Record AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS : Integer end;
  74.    var  Regs    : RegPack;
  75.    begin                                                 { set CH bit 5 high }
  76.       With Regs Do Begin AX := $0100; CX := $2000;
  77.    end;                                                  { to supress cursor }
  78.    Intr(16,Regs)
  79.    end; { of CursorOff }
  80.  
  81.  
  82. procedure Center(x,y : Integer; Text : AnyString); { Centers any string on   }
  83.    begin                                           { the screen              }
  84.       if y < 0 then y := 12;
  85.       if x < 0 then x := (80-Length(Text)) Div 2;  { negative num for x or y }
  86.       GotoXY(x,y);Write(Text);                     { centers side to side or }
  87.    end; { of procedure Center }                    { top to bottom or both   }
  88.  
  89.  
  90. procedure FirstScreen;
  91.    begin
  92.       CursorOff;
  93.       TextColor(Border); TextBackground(Back);
  94.       ClearBox(1,1,80,23);
  95.       GotoXY(1,1);Write(Chr(201));                      { upper left corner  }
  96.       GotoXY(80,1);Write(Chr(187));                     { upper right corner }
  97.       for I := 2 to 23 do begin
  98.          GotoXY(1,I);Write(Chr(186));                   { vertical borders   }
  99.          GotoXY(80,I);Write(Chr(186));
  100.       end;
  101.       GotoXY(1,24);Write(Chr(200));                     { lower left corner  }
  102.       GotoXY(80,24);Write(Chr(188));                    { lower right croner }
  103.       GotoXY(1,4);Write(Chr(204));                      { left intersection  }
  104.       GotoXY(1,21);Write(Chr(204));                     { left intersection  }
  105.       GotoXY(80,4);Write(Chr(185));                     { right intersection }
  106.       GotoXY(80,21);Write(Chr(185));                    { right intersection }
  107.       for I := 2 to 79 do begin
  108.          GotoXY(I,1);Write(Chr(205));                   { horizontal borders }
  109.          GotoXY(I,4);Write(Chr(205));
  110.          GotoXY(I,21);Write(Chr(205));
  111.          GotoXY(I,24);Write(Chr(205));
  112.       end;
  113.       Textcolor(Text);
  114.       Center(-1,2,
  115.       'PRINTER SETUP FOR THE IBM CONFIGURED OKIDATA MICROLINE 192 OR 193');
  116.       GotoXY(25,7);Write('Written 1/87 by Norman Newbury');
  117.       GotoXY(25,8);Write('PO BOX 1839, Glendale, Az 85311');
  118.       GotoXY(12,11);
  119.       Write('This Program is free to any one who wants it so long as');
  120.       GotoXY(12,12);
  121.       Write('it is not sold.  I encourage you to copy and pass it on.');
  122.       Center(-1,16,'Printer must be ready or program will not run');
  123.       TextColor(Bold);
  124.       Center(-1,22,'PREPARE PRINTER FOR OPERATION');
  125.       Center(-1,23,'PRESS ANY KEY TO CONTINUE');
  126.       GotoXY(12,16);TextColor(Border + Blink);Write('==>');
  127.       Read(Kbd,Ch);
  128.    end;{ of procedure FirstScreen }
  129.  
  130.  
  131. procedure DoneScreen;
  132. begin
  133.     ClearBox(2,5,78,20);
  134.     TextColor(Text);
  135.     Center(-1,-1,'PRINTER HAS YOUR SELECTION ');
  136.     delay(1000);
  137. end; { DoneScreen }
  138.  
  139.  
  140. procedure MainMenu;
  141.    begin
  142.       TextColor(Text);TextBackground(Back);
  143.       ClearBox(2,5,78,20);
  144.       GotoXY(27,6); Write('1 - PRINT SIZE AND QUALITY');
  145.       GotoXY(27,8); Write('2 - SET LINE SPACING');
  146.       GotoXY(27,10);Write('3 - SET MARGINS');
  147.       GotoXY(27,12);Write('4 - SELECT CHARACTER SET');
  148.       GotoXY(27,14);Write('5 - SELECT LANGUAGE SET');
  149.       GotoXY(27,16);Write('6 - SPECIAL FUNCTIONS');
  150.       GotoXY(27,18);Write('7 - ENGAGE DEFAULT SETTINGS');
  151.       GotoXY(27,20);Write('8 - PRINT TEST');
  152.       ClearBox(2,2,78,3);ClearBox(2,22,78,23);
  153.       Center(-1,2,'MAIN MENU');
  154.       Center(-1,23,'Press 1 - 8 To Select a Task');
  155.       TextColor(Bold);
  156.       Center(-1,22,'Esc TO EXIT PROGRAM');
  157.    end; { of procedure MainMenu }
  158.  
  159.  
  160. procedure FontMenu;
  161.    begin
  162.       TextColor(Text); TextBackground(Back);
  163.       ClearBox(2,5,78,20);
  164.       GotoXY(23,7); Write('1 - PICA.................. 10 CPI');
  165.       GotoXY(23,9); Write('2 - ELITE................. 12 CPI');
  166.       GotoXY(23,11);Write('3 - CONDENSED............. 17 CPI');
  167.       GotoXY(23,13);Write('4 - DOUBLE WIDE PICA......  5 CPI');
  168.       GotoXY(23,15);Write('5 - DOUBLE WIDE ELITE.....  6 CPI');
  169.       GotoXY(23,17);Write('6 - DOUBLE WIDE CONDENSED 8.5 CPI');
  170.       ClearBox(2,2,78,3);ClearBox(2,22,78,23);
  171.       Center(-1,2,'FONT SELECTION');
  172.       Center(-1,23,'Press 1 - 6 To Select a Font');
  173.    end; { Font Menu  }
  174.  
  175.  
  176. procedure QualityMenu;
  177.    begin
  178.       ClearBox(2,5,78,20);
  179.       GotoXY(27,8); Write('1 - NORMAL DATA PROCESSING');
  180.       GotoXY(27,10);Write('2 - CORRESPONDENCE QUALITY');
  181.       GotoXY(27,12);Write('3 - ENHANCED');
  182.       GotoXY(27,14);Write('4 - EMPHASIZED');
  183.       GotoXY(27,16);Write('5 - ENHANCED AND EMPHASIZED');
  184.       ClearBox(2,2,78,3);ClearBox(2,22,78,23);
  185.       Center(-1,2,'PRINT QUALITY MENU');
  186.       Center(-1,23,'Press 1 - 5 To Select Impact Quality');
  187.    end; { QualityMenu }
  188.  
  189.  
  190. procedure LineSpaceMenu;
  191.    begin
  192.       TextColor(Text);TextBackground(Back);
  193.       ClearBox(2,5,78,20);
  194.       GotoXY(25,8); Write('1 - 6 LINES PER INCH');
  195.       GotoXY(25,10);Write('2 - 8 LINES PER INCH');
  196.       GotoXY(25,12);Write('3 - 10.2 LINES PER INCH (7/72)');
  197.       GotoXY(25,14);Write('4 - N/72 INCH  (max N is 85)');
  198.       GotoXY(25,16);Write('5 - N/216 INCH (max N is 255)');
  199.       ClearBox(2,2,78,3);ClearBox(2,22,78,23);
  200.       Center(-1,2,'LINE SPACING MENU');
  201.       Center(-1,23,'Press 1 - 5 To Set Line Spacing ');
  202.       TextColor(Bold);
  203.       Center(-1,22,'Esc TO RETURN TO MAIN MENU');
  204.    end; { of LineSpaceMenu }
  205.  
  206.  
  207. procedure MarginsMenu;
  208.    begin
  209.       TextColor(Text);TextBackground(Back);
  210.       ClearBox(2,5,78,20);
  211.       GotoXY(22,11);Write('1 - SET MARGINS');
  212.       GotoXY(22,13);Write('2 - RESET MARGINS TO COLUMNS 1 - 80 ');
  213.       ClearBox(2,2,78,3);ClearBox(2,22,78,23);
  214.       Center(-1,2,'MARGINS MENU');
  215.       Center(-1,23,'Press 1 - 2 To Set Margins');
  216.       TextColor(Bold);
  217.       Center(-1,22,'Esc TO RETURN TO PREVIOUS MENU');
  218.    end; { of Margins Menu }
  219.  
  220.  
  221. procedure LanguageSetMenu;
  222.    begin
  223.       TextColor(Text);TextBackground(Back);
  224.       ClearBox(2,5,78,20);
  225.       GotoXy(28,7); Write('1 - ASCII (slashed 0)');
  226.       GotoXy(28,8); Write('2 - ASCII (unslashed 0)');
  227.       GotoXy(28,9); Write('3 - BRITISH');
  228.       GotoXy(28,10);Write('4 - GERMAN');
  229.       GotoXy(28,11);Write('5 - FRENCH');
  230.       GotoXy(28,12);Write('6 - SWEDISH');
  231.       GotoXy(28,13);Write('7 - DANISH');
  232.       GotoXy(28,14);Write('8 - NORWEGIAN');
  233.       GotoXy(28,15);Write('9 - DUTCH');
  234.       GotoXy(28,16);Write('I - ITALIAN');
  235.       GotoXy(28,17);Write('F - FRENCH CANADIAN');
  236.       GotoXy(28,18);Write('S - SPANISH');
  237.       ClearBox(2,2,78,3);ClearBox(2,22,78,23);
  238.       Center(-1,2,'LANGUAGE SET MENU');
  239.       Center(-1,23,'Press 1 - S To Select a Language Set');
  240.       TextColor(Bold);
  241.       Center(-1,22,'Esc TO RETURN TO MAIN MENU');
  242.    end; { of language set menu }
  243.  
  244.  
  245. procedure CharacterSetMenu;
  246.    begin
  247.       TextColor(Text);TextBackground(Back);
  248.       ClearBox(2,5,78,20);
  249.       Center(-1,11,'1 - IBM SET 1');
  250.       Center(-1,13,'2 - IBM SET 2');
  251.       ClearBox(2,2,78,3);ClearBox(2,22,78,23);
  252.       Center(-1,2,'CHARACTER SET MENU');
  253.       Center(-1,23,'Press 1 - 2 To Select a Character Set');
  254.       TextColor(Bold);
  255.       Center(-1,22,'Esc TO RETURN TO MAIN MENU');
  256.    end; { of character set menu }
  257.  
  258.  
  259. procedure SpecialFunctionMenu;
  260.    begin
  261.       TextColor(Text);TextBackground(Back);
  262.       ClearBox(2,5,78,20);
  263.       GotoXY(24,7); Write('1 - SKIP OVER PERFORATION');
  264.       GotoXY(24,9); Write('2 - SET FORM LENGTH');
  265.       GotoXY(24,11);Write('3 - PRINTHEAD LEFT TO RIGHT ONLY');
  266.       GotoXY(24,13);Write('4 - PRINTHEAD BIDIRECTIONAL');
  267.       GotoXY(24,15);Write('5 - PAPER-OUT DETECTOR DISABLE');
  268.       GotoXY(24,17);Write('6 - PAPER-OUT DETECTOR ENABLE');
  269.       ClearBox(2,2,78,3);ClearBox(2,22,78,23);
  270.       Center(-1,2,'SPECIAL FUNCTIONS MENU');
  271.       Center(-1,23,'Press 1 - 6 To Set a Special Function');
  272.       TextColor(Bold);
  273.       Center(-1,22,'Esc TO RETURN TO MAIN MENU');
  274.    end; { of SpecialFunctionMenu }
  275.  
  276.  
  277. procedure PrintTestMenu;
  278.    begin
  279.       TextColor(Text);TextBackground(Back);
  280.       ClearBox(2,5,78,20);
  281.       GotoXY(15,7);
  282.       Write('If you are using paper less than the full carriage');
  283.       GotoXY(15,8);
  284.       Write('width you could print off the form with this test.');
  285.       Center(-1,10,'Set your right margin if necessary.');
  286.       GotoXY(23,15);Write('1 - DO THE PRINT TEST');
  287.       GotoXY(23,17);Write('2 - SET MARGINS BEFORE PRINT TEST');
  288.       ClearBox(2,2,78,3);ClearBox(2,22,78,23);
  289.       Center(-1,2,'PRINT TEST MENU');
  290.       Center(-1,23,'Press 1 - 2 To Set Up The Print Test');
  291.       TextColor(Bold);
  292.       Center(-1,22,'Esc EXIT TO MAIN MENU (no test)');
  293.    end; { of procedure PrintTestMenu }
  294.  
  295.  
  296. Procedure DefaultScreen;
  297.    begin
  298.       TextColor(Text);TextBackground(Back);
  299.       ClearBox(2,5,78,20);
  300.       GotoXY(27,8); Write('PICA FONT DATA PROCESSING MODE');
  301.       GotoXY(27,9); Write('6 LINES PER INCH');
  302.       GotoXY(27,10);Write('66 LINES PER PAGE');
  303.       GotoXY(27,11);Write('11 INCH PAGE LINGTH');
  304.       GotoXY(27,12);Write('IBM SET # 1, ASCII UNSLASHED 0');
  305.       GotoXY(27,13);Write('RESET MARGINS TO COLUMN 1 - 80 ');
  306.       GotoXY(27,14);Write('PAPER OUT DETECTOR ENABLE');
  307.       GotoXY(27,15);Write('PERFORATION SKIP = 1 LINE');
  308.       GotoXY(27,16);Write('BIDIRECTIONAL PRINTING');
  309.       ClearBox(2,2,78,3);ClearBox(2,22,78,23);
  310.       Center(-1,2,'DEFAULTS SELECTED');
  311.       TextColor(Bold);
  312.       Center(-1,23,'PRESS ANY KEY TO CONTINUE');
  313.    end; { of defaultScreen }
  314.  
  315.  
  316. {****************************************************************************}
  317. {*                                                                          *}
  318. {*                           UTILITY PROCEDURES                             *}
  319. {*                                                                          *}
  320. {****************************************************************************}
  321.  
  322.  
  323. procedure ResetPrintMode;            { clears special print & returns DP mode}
  324.    begin
  325.       Write(Lst,Chr(27),Chr(87),Chr(48));             { double wide off      }
  326.       Write(Lst,Chr(27),Chr(72));                     { enhanced off         }
  327.       Write(Lst,Chr(27),Chr(70));                     { emphasized off       }
  328.       Write(Lst,Chr(27),Chr(73),Chr(1));              { data processing mode }
  329.       Write(Lst,Chr(18));                             { pica - 10 cpi        }
  330.    end;{ of ResetPrintMode }
  331.  
  332.  
  333. procedure SkipPerf;                  { sets printer to skip over perforation }
  334.    var Lines : Integer;
  335.    begin
  336.       ClearBox(2,22,78,23);TextColor(Text);
  337.       Center(-1,23,'Range is 0 - 127 lines');
  338.       {$I-}                                             { compiler directive }
  339.       repeat
  340.          ClearBox(2,5,78,20);
  341.          Center(-1,-1,'ENTER NUMBER OF LINES TO SKIP AT PERFORATION  ');
  342.          Read(Lines); IOerr := (IOresult<>0);
  343.          if IOerr or (Lines < 0) or (Lines > 127) then begin
  344.             Center(-1,14,'Error, try again'+ Beep);
  345.          end; { of if error }
  346.       until (Lines >= 0) and (Lines <128) and not IOerr;
  347.       {$I+}                                             { compiler directive }
  348.       if Lines = 0 then Write(Lst,Chr(27),Chr(79))
  349.       else Write(Lst,Chr(27),Chr(78),Chr(Lines));       { set perf skip      }
  350.    end; { of procedure SkipPerf }
  351.  
  352.  
  353.  
  354. procedure FormLength;                { sets form length 1 to 22 inches       }
  355.    var Inches : Integer;
  356.    begin
  357.       ClearBox(2,22,78,23);TextColor(text);
  358.       Center(-1,23,'Range is 1 - 22 inches');
  359.       {$I-}                                             { compiler directive }
  360.       repeat
  361.          ClearBox(2,5,78,20);
  362.          Center(-1,-1,'ENTER FORM LENGTH IN INCHES ');
  363.          Read(Inches); IOerr := (IOresult<>0);
  364.          if IOerr or (Inches < 1) or (Inches > 22) then begin
  365.             Center(-1,14,'Error, try again' + Beep);
  366.          end; { of if error }
  367.       until (Inches > 0) and (Inches < 23) and not IOerr;
  368.       {$I+}                                             { compiler directive }
  369.       Write(Lst,Chr(27),Chr(67),Chr(0),Chr(Inches));    { set form length    }
  370.       DoneScreen;
  371.    end; { of procedure FormLength }
  372.  
  373.  
  374. {****************************************************************************}
  375. {*                                                                          *}
  376. {*                             FONT SELECTION                               *}
  377. {*                                                                          *}
  378. {****************************************************************************}
  379.  
  380.  
  381. procedure SelectFont;
  382.   const Condensed : Boolean = false;
  383.   begin
  384.      FontMenu; ResetPrintMode; Condensed := false;
  385.      repeat
  386.         Read(Kbd,Ch);
  387.      until (Ch IN ['1','2','3','4','5','6']);
  388.      case Ch of
  389.         '1' : Write(Lst,Chr(18));                     { pica  - 10 char/inch }
  390.         '2' : Write(Lst,Chr(27),Chr(58));             { elite - 12 char/inch }
  391.         '3' : begin
  392.                  Write(Lst,Chr(15));                  { condensed - 17 char  }
  393.                  Condensed := true;
  394.               end;
  395.         '4' : Write(Lst,Chr(18),                      { pica                 }
  396.                         Chr(27),Chr(87),Chr(49));     { double wide on       }
  397.         '5' : Write(Lst,Chr(27),Chr(58),              { elite                }
  398.                         Chr(27),Chr(87),Chr(49));     { double wide on       }
  399.         '6' : begin
  400.                  Write(Lst,Chr(15),                   { condensed            }
  401.                            Chr(27),Chr(87),Chr(49));  { double wide on       }
  402.                  Condensed := true;
  403.               end;
  404.      end; { of case }
  405.      If not Condensed then begin                      { data processing only }
  406.         QualityMenu;                                  { with condensed font  }
  407.         repeat
  408.            Read(Kbd,Ch);
  409.         until (Ch IN ['1','2','3','4','5']);
  410.         case Ch of
  411.            '1' : write(Lst,Chr(27),Chr(73),Chr(1));   { data processing      }
  412.            '2' : Write(Lst,Chr(27),Chr(73),Chr(3));   { correspondence       }
  413.            '3' : Write(Lst,Chr(27),Chr(71));          { enhanced             }
  414.            '4' : Write(Lst,Chr(27),Chr(69));          { emphasized           }
  415.            '5' : Write(Lst,Chr(27),Chr(69),           { both emphasized and  }
  416.                            Chr(27),Chr(71));          { enhanced printing    }
  417.         end; { of case }
  418.      end; { of if not condensed }
  419.      DoneScreen;
  420.   end; { of SelectFont }
  421.  
  422. {****************************************************************************}
  423. {*                                                                          *}
  424. {*                               LINE SPACING                               *}
  425. {*                                                                          *}
  426. {****************************************************************************}
  427.  
  428.  
  429. procedure SetLineSpacing;
  430.    var N : Integer;
  431.    begin
  432.       LineSpaceMenu;TextColor(Text); Done := false;
  433.       repeat
  434.          Read(Kbd,Ch);
  435.       until (Ch IN ['1','2','3','4','5','6',#27]);
  436.       case Ch of
  437.          '1' : Write(Lst,Chr(27),Chr(65),Chr(12),    { 1/6 spacing (12/72)   }
  438.                          Chr(27),Chr(50));           { activate N/72 spacing }
  439.          '2' : Write(Lst,Chr(27),Chr(48));           { 1/8 spacing           }
  440.          '3' : Write(Lst,Chr(27),Chr(49));           { 1/10.2 spacing (7/72) }
  441.          '4' : begin
  442.                   ClearBox(2,22,78,23);
  443.                   Center(-1,23,'Range is 1 - 85');
  444.                   {$I-}                              { compiler directive    }
  445.                   repeat
  446.                      ClearBox(2,5,78,20);
  447.                      Center(-1,-1,'ENTER (N/72) VALUE  ');
  448.                      Read(N); IOerr := (IOresult<>0);
  449.                      if IOerr or (N < 1) or (N > 85) then begin
  450.                         Center(-1,14,'Error, try again'+ Beep);
  451.                      end; { of if error }
  452.                  until (N > 0) and (N < 86) and not IOerr;
  453.                  {$I+}                               { compiler directive    }
  454.                  Write(Lst,Chr(27),Chr(65),Chr(N),   { set spacing to N/72   }
  455.                            Chr(27),Chr(50));         { activate N/72 spacing }
  456.                end;
  457.          '5' : begin
  458.                   ClearBox(2,22,78,23);
  459.                   Center(-1,23,'Range is 1 - 255');
  460.                   {$I-}                              { compiler directive    }
  461.                   repeat
  462.                      ClearBox(2,5,78,20);
  463.                      Center(-1,-1,'ENTER (N/216) VALUE  ');
  464.                      Read(N);IOerr := (IOresult<>0);
  465.                      if IOerr or (N < 1) or (N > 255) then begin
  466.                         Center(-1,14,'Error, try again'+ Beep);
  467.                      end; { of if error }
  468.                   until (N > 0) and (N < 256) and not IOerr;
  469.                   {$I+}                              { compiler directive    }
  470.                   Write(Lst,Chr(27),Chr(51),Chr(N)); { set spacing to N/216  }
  471.                end;
  472.          #27 : Done := true;
  473.       end; { of case }
  474.       if not Done then begin SkipPerf; DoneScreen; end;
  475.    end; { of SetLineSpacing }
  476.  
  477.  
  478. {****************************************************************************}
  479. {*                                                                          *}
  480. {*                               SET MARGINS                                *}
  481. {*                                                                          *}
  482. {****************************************************************************}
  483.  
  484.  
  485. procedure SetMargins;
  486.    var
  487.       Left,Right : Integer;
  488.    begin
  489.       MarginsMenu;Done := false;
  490.       repeat
  491.          Read(Kbd,Ch);
  492.       until (Ch IN ['1','2',#27]);
  493.       case Ch of
  494.          '1' : begin
  495.                   ClearBox(2,22,78,23);
  496.                   Center(-1,23,'Minimum between left and right is 10');
  497.                   {$I-}                                 { compiler directive }
  498.                   repeat
  499.                      ClearBox(2,5,78,20);TextColor(Text);
  500.                      Center(-1,-1,'ENTER LEFT COLUMN NUMBER   ');
  501.                      Read(Left); IOerr := (IOresult<>0);
  502.                      if IOerr or (Left < 1) or (Left > 220) then begin
  503.                         Center(-1,15,'Error try again'+ Beep);
  504.                      end; { of if error }
  505.                   until not IOerr and ((Left >= 1) and (Left <= 220));
  506.                   repeat
  507.                      ClearBox(2,5,78,20);
  508.                      Center(-1,10,'Left margin set at column ');
  509.                      Write(Left);
  510.                      Center(-1,14,' ENTER RIGHT COLUMN NUMBER ');
  511.                      Read(Right);IOerr := (IOresult<>0);
  512.                      if IOerr or (Right-Left < 10) or (Right > 233) then begin
  513.                         Center(-1,16,'Error, try again'+ Beep);
  514.                      end; { of if error }
  515.                   until not IOerr and (Right-Left >= 10) and (Right <= 233);
  516.                   {$I+}                                  { compiler directive}
  517.                   Write(Lst,Chr(27),Chr(88),
  518.                             Chr(Left),Chr(Right));       { set margins       }
  519.                end; { of case '1' }
  520.          '2' : write(Lst,Chr(27),Chr(88),Chr(1),Chr(80));{ reset to 1 - 80   }
  521.          #27 : Done := true;
  522.       end; { of case }
  523.       if not Done then DoneScreen;
  524.    end; { Set Margins }
  525.  
  526.  
  527. {****************************************************************************}
  528. {*                                                                          *}
  529. {*                              CHARACTER SETS                              *}
  530. {*                                                                          *}
  531. {****************************************************************************}
  532.  
  533.  
  534. procedure SelectCharacterSet;
  535.    begin
  536.        CharacterSetMenu;Done := false;
  537.        repeat
  538.           Read(Kbd,Ch);
  539.           Ch := UpCase(Ch);
  540.        until (Ch IN ['1','2',#27]);
  541.        case Ch of
  542.           '1' : begin
  543.                    Write(Lst,Chr(27),Chr(55));          { IBM set 1          }
  544.                    IBM2 := false;
  545.                 end;
  546.           '2' : begin
  547.                    Write(Lst,Chr(27),Chr(54));          { IBM set 2          }
  548.                    IBM2 := true;
  549.                 end;
  550.           #27 : Done := true;
  551.        end; { of case }
  552.        if not Done then DoneScreen;
  553.    end; { SelectCharacterSet }
  554.  
  555.  
  556.  
  557. {****************************************************************************}
  558. {*                                                                          *}
  559. {*                              LANGUAGE SETS                               *}
  560. {*                                                                          *}
  561. {****************************************************************************}
  562.  
  563.  
  564. procedure SelectLanguageSet;
  565.    begin
  566.        LanguageSetMenu;Done := false;
  567.        repeat
  568.           Read(Kbd,Ch);
  569.           Ch := UpCase(Ch);
  570.        until (Ch IN ['1','2','3','4','5','6','7','8','9','I','F','S',#27]);
  571.        case Ch of
  572.           '1' : begin
  573.                    Write(Lst,Chr(27),Chr(33),Chr(64));
  574.                    SetStr := 'ASCII slashed 0';
  575.                 end;
  576.           '2' : begin
  577.                    Write(Lst,Chr(27),Chr(33),Chr(65));
  578.                    SetStr := 'ASCII unslashed 0';
  579.                 end;
  580.           '3' : begin
  581.                    Write(Lst,Chr(27),Chr(33),Chr(66));SetStr := 'British';
  582.                 end;
  583.           '4' : begin
  584.                    Write(Lst,Chr(27),Chr(33),Chr(67));SetStr := 'German';
  585.                 end;
  586.           '5' : begin
  587.                    Write(Lst,Chr(27),Chr(33),Chr(68));SetStr := 'French';
  588.                 end;
  589.           '6' : begin
  590.                    Write(Lst,Chr(27),Chr(33),Chr(69));SetStr := 'Swedish';
  591.                 end;
  592.           '7' : begin
  593.                    Write(Lst,Chr(27),Chr(33),Chr(70));SetStr := 'Danish';
  594.                 end;
  595.           '8' : begin
  596.                    Write(Lst,Chr(27),Chr(33),Chr(71));SetStr := 'Norwegian';
  597.                 end;
  598.           '9' : begin
  599.                    Write(Lst,Chr(27),Chr(33),Chr(72));SetStr := 'Dutch';
  600.                 end;
  601.           'I' : begin
  602.                    Write(Lst,Chr(27),Chr(33),Chr(73));SetStr := 'Itialian';
  603.                 end;
  604.           'F' : begin
  605.                    Write(Lst,Chr(27),Chr(33),Chr(74));
  606.                    SetStr := 'French Canadian';
  607.                 end;
  608.           'S' : begin
  609.                    Write(Lst,Chr(27),Chr(33),Chr(75));SetStr := 'Spanish';
  610.                 end;
  611.           #27 : Done := true;
  612.        end; { of case }
  613.        if not Done then DoneScreen;
  614.    end; { SelectLanguageSet }
  615.  
  616.  
  617.  
  618. {****************************************************************************}
  619. {*                                                                          *}
  620. {*                            SPECIAL FUNCTIONS                             *}
  621. {*                                                                          *}
  622. {****************************************************************************}
  623.  
  624.  
  625. procedure SelectSpecialFunction;
  626.    begin
  627.       Done := false;
  628.       While not Done do begin
  629.          SpecialFunctionMenu;
  630.          repeat
  631.             Read(Kbd,Ch);
  632.          until (Ch IN ['1','2','3','4','5','6',#27]);
  633.          case Ch of
  634.            '1' : begin SkipPerf; DoneScreen; end;
  635.            '2' : begin FormLength; SkipPerf; DoneScreen; end;
  636.            '3' : begin
  637.                     Write(Lst,Chr(27),Chr(85),Chr(1));  { printhead l to r   }
  638.                     DoneScreen;
  639.                  end;
  640.            '4' : begin
  641.                     Write(Lst,Chr(27),Chr(85),Chr(0));  { printhead l and r  }
  642.                     DoneScreen;
  643.                  end;
  644.            '5' : begin
  645.                     Write(Lst,Chr(27),Chr(56));         { paper-out disable  }
  646.                     DoneScreen;
  647.                  end;
  648.            '6' : begin
  649.                     Write(Lst,Chr(27),Chr(57));         { paper-out enable   }
  650.                     DoneScreen;
  651.                  end;
  652.            #27 : Done := true;
  653.          end; { of case }
  654.       end; { of while not done }
  655.    end; { SelectSpecialFunction }
  656.  
  657.  
  658. {****************************************************************************}
  659. {*                                                                          *}
  660. {*                             ENGAGE DEFAULTS                              *}
  661. {*                                                                          *}
  662. {****************************************************************************}
  663.  
  664.  
  665. procedure EngageDefaults;
  666.    begin
  667.       DefaultScreen;
  668.       ResetPrintMode;                                    { pica, data process}
  669.       Write(Lst,Chr(27),Chr(67),Chr(0),Chr(11));         { page = 11 inches  }
  670.       Write(Lst,Chr(27),Chr(65),Chr(12),
  671.                 Chr(27),Chr(50));                        { 1/6 line spacing  }
  672.       Write(Lst,Chr(27),Chr(78),Chr(1));                 { skip perf = 1 line}
  673.       Write(Lst,Chr(27),Chr(88),Chr(1),Chr(80));         { margin 1 & 80     }
  674.       Write(Lst,Chr(27),Chr(55));                        { chr set IBM-1     }
  675.       Write(Lst,Chr(27),Chr(33),Chr(65));                { ASCII unslashed 0 }
  676.       Write(Lst,Chr(27),Chr(57));                        { paper out on      }
  677.       Write(Lst,Chr(27),Chr(85),Chr(0));                 { bidirectional prn }
  678.       Read(Kbd,Ch);
  679.   end; { EngageDefaults }
  680.  
  681.  
  682. {****************************************************************************}
  683. {*                                                                          *}
  684. {*                                PRINT TEST                                *}
  685. {*                                                                          *}
  686. {****************************************************************************}
  687.  
  688.  
  689. procedure DoPrintTest;
  690.    var
  691.       Index     : Integer;                               { array index       }
  692.       Counter   : Integer;                               { character counter }
  693.       Code      : String[3];                             { holds ASCII code  }
  694.       PrintStr  : Array[1..255] of String [6];           { array of print str}
  695.    begin
  696.       Done := false;
  697.       while not Done do begin
  698.          PrintTestMenu;
  699.          repeat
  700.             Read(Kbd,Ch);
  701.          until (Ch IN ['1','2',#27]);
  702.          case Ch of
  703.             '1' : begin
  704.                      Index := 0;Counter := 0;
  705.                      for I := 1 to 6 do WriteLn(Lst);
  706.                      if IBM2
  707.                         then Write(Lst,'IBM set 2, ')
  708.                         else Write(Lst,'IBM set 1, ');
  709.                      WriteLn(Lst,'Language set: ',SetStr);
  710.                      WriteLn(Lst,'┌─────────────────────────────┐');
  711.                      WriteLn(Lst,'│Special for this language set│');
  712.                      WriteLn(Lst,'├─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┤');
  713.                      WriteLn(Lst,'│#│&│0│@│O│[│\│]│^│_│`│{│|│}│~│');
  714.                      WriteLn(Lst,'└─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┘');
  715.                      WriteLn(Lst);
  716.                      WriteLn(Lst,'TEST LINE TEST LINE;test line test line');
  717.                      WriteLn(Lst,'TEST LINE TEST LINE;test line test line');
  718.                      WriteLn(Lst,'233 columns, (the maximum possible)');
  719.                      Write(Lst,'L--------10--------20--------30--------4');
  720.                      Write(Lst,'0--------50--------60--------70--------8');
  721.                      Write(Lst,'0--------90--------100-------110-------1');
  722.                      Write(Lst,'20-------130-------140-------150-------1');
  723.                      Write(Lst,'60-------170-------180-------190-------2');
  724.                      Write(Lst,'00-------210-------220-------230R');
  725.                      WriteLn(Lst);WriteLn(Lst);
  726.                      WriteLn(Lst,'Printable characters for ',SetStr);
  727.                      WriteLn(Lst,'─────────────────────────────────────────');
  728.                      if IBM2 then begin               { start building array }
  729.                         for I := 3 to 6 do begin
  730.                            Index := Index +1;Str(I,Code);
  731.                            PrintStr[Index] := Code+'   '+Chr(I)+'│';
  732.                            Write(Lst,Chr(I));
  733.                         end;
  734.                         Index := Index +1;
  735.                         PrintStr[Index] := '21'+'  '+Chr(21)+'│';
  736.                         Write(Lst,Chr(21));
  737.                      end;
  738.                      for I := 33 to 99 do begin
  739.                         Index := Index +1;Str(I,Code);
  740.                         PrintStr[Index] := Code+'  '+Chr(I)+'│';
  741.                         Write(Lst,Chr(I));
  742.                      end;
  743.                      for I := 100 to 126 do begin
  744.                         Index := Index +1;Str(I,Code);
  745.                         PrintStr[Index] := Code+' '+Chr(I)+'│';
  746.                         Write(Lst,Chr(I));
  747.                      end;
  748.                      if IBM2 then I := 128 else I := 160;
  749.                      for I := I to 254 do begin
  750.                         Index := Index +1;Str(I,Code);
  751.                         PrintStr[Index] := Code+' '+Chr(I)+'│';
  752.                         Write(Lst,Chr(I));
  753.                      end;
  754.                      WriteLn(Lst);WriteLn(Lst);WriteLn(Lst);
  755.                      for I := 1 to Index do begin      { print out the array }
  756.                         Write(Lst,PrintStr[I]);
  757.                         Counter := Counter +1;
  758.                         if Counter >= 8 then begin
  759.                            Write(Lst,Chr(10),Chr(13));
  760.                            Counter := 0;
  761.                         end;
  762.                      end;
  763.                      Done := true;
  764.                      Write(Lst,Chr(27),Chr(60),Chr(12));
  765.                   end; { of case 1 }
  766.             '2' : begin SetMargins;Done := false; end;
  767.             #27 : Done := true;
  768.          end; { of case '1' }
  769.       end; { of while }
  770.    end; { DoPrintTestn }
  771.  
  772.  
  773. {****************************************************************************}
  774. {*                                                                          *}
  775. {*                              BEGIN PROGRAM                               *}
  776. {*                                                                          *}
  777. {****************************************************************************}
  778.  
  779.  
  780. begin
  781.    FirstScreen;
  782.    while working do begin
  783.       MainMenu;
  784.       repeat
  785.          Read(Kbd,Ch);
  786.       until (Ch IN ['1','2','3','4','5','6','7','8',#27]);
  787.       case Ch of
  788.          '1' : SelectFont;
  789.          '2' : SetLineSpacing;
  790.          '3' : SetMargins;
  791.          '4' : SelectCharacterSet;
  792.          '5' : SelectLanguageSet;
  793.          '6' : SelectSpecialFunction;
  794.          '7' : EngageDefaults;
  795.          '8' : DoPrintTest;
  796.          #27 : working := false;
  797.       end; { of case }
  798.    end; { of while working }
  799.    ClearBox(2,5,78,20);TextColor(Border + Blink);           { end of program }
  800.    Center(-1,-1,'BYE');delay(2000);                         { routine here   }
  801.    TextColor(7);TextBackground(0);ClrScr;
  802.    CursorOn;
  803. end. { of program Printer }
  804.